home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / gsdb21.arc / GS_DBNDX.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-04  |  57KB  |  1,320 lines
  1. {
  2.                            dBase III Index Handler
  3.  
  4.        GS_DBNdx Copyright (c)  Richard F. Griffin
  5.  
  6.        15 November 1990
  7.  
  8.        102 Molded Stone Pl
  9.        Warner Robins, GA  31088
  10.  
  11.        -------------------------------------------------------------
  12.        This unit handles the objects for all dBase III index (.NDX)
  13.        operations.
  14.  
  15.        changes:
  16.  
  17.           16 Nov 90 - Modified KeyUpdate sub-procedure KeyInsert to
  18.                       test for end-of-file during search for key.
  19.  
  20.  
  21. }
  22. {.pa}
  23. {
  24.  
  25.  
  26.                             ┌─────────────────────┐
  27.                             │  INTERFACE SECTION  │
  28.                             └─────────────────────┘
  29. }
  30.  
  31. unit GS_DBNdx;
  32.  
  33. (*$N+,E+*)                            {Numeric coprocessor or emulation is}
  34.                                       {required to handle the double type}
  35.                                       {that dBase uses to store number and}
  36.                                       {date fields. If not using date or }
  37.                                       {numeric values, 16K of memory can}
  38.                                       {be avoided by deleting this and}
  39.                                       {changing double types to integer}
  40.  
  41. interface
  42.  
  43. uses
  44.    GS_Strng,                          {String handler routines}
  45.    GS_Error,                          {Error handler routines}
  46.    GS_FileH;                          {File handler routines}
  47.  
  48. const
  49.    NdxBufSize = 16384;
  50.  
  51. type
  52.  
  53. {
  54.          ┌──────────────────────────────────────────────────────────┐
  55.          │  ********      Index Header Description       ********   │
  56.          │                                                          │
  57.          │  This record type describes the index file header.       │
  58.          │  This is a 512-byte block that is located at the         │
  59.          │  beginning of the index file.  Refer to Appendix C       │
  60.          │  for a description of the fields.                        │
  61.          └──────────────────────────────────────────────────────────┘
  62. }
  63.    GS_Indx_Head = Record
  64.                             Root        : Longint;
  65.                             Next_Blk    : Longint;
  66.                             Unknwn1     : Longint;
  67.                             Key_Lgth    : Integer;
  68.                             Max_Keys    : Integer;
  69.                             Data_Typ    : Integer;
  70.                             Entry_Sz    : Integer;
  71.                             Unknwn2     : Longint;
  72.                             Key_Form    : array [0..487] of char;
  73.                   end;
  74.  
  75. {
  76.          ┌──────────────────────────────────────────────────────────┐
  77.          │  ********   Index Node Header Description     ********   │
  78.          │                                                          │
  79.          │  This record type describes the index file node header.  │
  80.          │  Each node is a 512-byte block that is used as nodes     │
  81.          │  to store keys and pointers.  Refer to Appendix C        │
  82.          │  for a description of the fields.                        │
  83.          └──────────────────────────────────────────────────────────┘
  84. }
  85.  
  86.    GS_Indx_Data = Record
  87.                      Entry_Ct    : Integer;
  88.                      Unknwn1     : Integer;
  89.                      Data_Ary    : array [0..507] of byte;
  90.                                       {Memory array holding key entries}
  91.                      Filler1     : array [0..255] of byte;
  92.                                       {Filler for possible overflow during}
  93.                                       {insert mode.}
  94.                   end;
  95.  
  96.    GS_Indx_EntPtr = ^GS_Indx_Etry;    {Pointer of type GS_Indx_Etry.  Will}
  97.                                       {be used to reference key entries  }
  98.                                       {from GS_Indx_Data.Data_Ary.}
  99.  
  100. {
  101.          ┌──────────────────────────────────────────────────────────┐
  102.          │  ********   Index Node Key Entry Description   *******   │
  103.          │                                                          │
  104.          │  This record type describes the index file key entries.  │
  105.          │  Refer to Appendix C for a description of each field.    │
  106.          └──────────────────────────────────────────────────────────┘
  107. }
  108.  
  109.    GS_Indx_Etry = Record
  110.                      Block_Ax : Longint;
  111.                      Recrd_Ax : Longint;
  112.                      case Integer of
  113.                          0      : (Char_Fld : array [1..255] of char);
  114.                          1      : (Numb_Fld : double);
  115.                                       {dBase numeric and date fields are}
  116.                                       {stored as a floating point double}
  117.                  end;
  118.  
  119. {
  120.           ┌────────────────────────────────────────────────────────┐
  121.           │  Work table used to step through nodes.  The previous  │
  122.           │  nodes must be saved for finding the next or previous  │
  123.           │  record during sequential reads.                       │
  124.           └────────────────────────────────────────────────────────┘
  125. }
  126.     GS_Indx_Tabl = Record
  127.                       Page_No  : Longint;   {Disk block holding node info}
  128.                       Etry_No  : Longint;   {Last entry used in node}
  129.                       Last_One : Longint;   {Number of keys in this node }
  130.                       Node_Pag : Boolean;   {True for non-leaf nodes}
  131.                    end;
  132.  
  133.    GS_Indx_LPtr = ^GS_dBase_IX;       {Pointer to object.  Used by GS_dBase_DB}
  134.  
  135. {
  136.                       ┌─────────────────────────────────┐
  137.                       │  GS_dBase_IX Object Definition  │
  138.                       └─────────────────────────────────┘
  139. }
  140.  
  141.    GS_dBase_IX = object
  142.       Ndx_Name     : String[64];      {File name of index file}
  143.       Ndx_Hdr      : GS_Indx_Head;    {Index header information}
  144.       Ndx_File     : file;            {File type for index file}
  145.       Ndx_Tabl     : array [0..25] of GS_Indx_Tabl;
  146.                                       {Array of 25 table entries to hold}
  147.                                       {the trail of non-leaf nodes that are}
  148.                                       {traversed during a key search.  This }
  149.                                       {table is needed to track positions for}
  150.                                       {sequential reads (next and previous).}
  151.  
  152.       Ndx_Lvl      : integer;         {Holds counter into Ndx_Tabl}
  153.       Ndx_Data     : GS_Indx_Data;    {Node header information}
  154.       Ndx_Pntr     : GS_Indx_EntPtr;  {Pointer to key entry information}
  155.       Ndx_Key_St   : string[127];     {Holds last key value found on call to}
  156.                                       {either KeyRead or KeyFind}
  157.  
  158.       Ndx_Key_Num  : longint;         {Holds last physical record number for a}
  159.                                       {key value found on call to either}
  160.                                       {KeyRead or KeyFind}
  161.       Ndx_Key_Form : string[127];     {Holds the key formula in type string}
  162.       KeyEOF       : boolean;         {True if last KeyRead attempted to read}
  163.                                       {beyond the range of index keys - either}
  164.                                       {beyond beginning or end of file}
  165.       ExactMatch   : boolean;         {Flag for type of test to use in KeyFind}
  166.                                       {It will force a match against an entire}
  167.                                       {key if true, and only for the length of}
  168.                                       {the passed argument if false.  It is}
  169.                                       {initialized true.}
  170.  
  171.  
  172. {
  173.    ┌───────────────────────────────────────────────────────────────────────┐
  174.    │  ***  These methods are described individually in the following  ***  │
  175.    │       pages.  Their name describes their function.                    │
  176.    └───────────────────────────────────────────────────────────────────────┘
  177. }
  178.  
  179.       FUNCTION  Init(IName : String) : boolean;
  180.       FUNCTION  KeyFind(st : String) : longint;
  181.       FUNCTION  KeyLocRec(rec : longint) : boolean;
  182.       FUNCTION  KeyRead(a : LongInt) : longint;
  183.       PROCEDURE KeyUpdate (st : string; rec, crec : longint);
  184.       PROCEDURE Ndx_Close;
  185.       PROCEDURE Ndx_Get(blk : longint);
  186.       PROCEDURE Ndx_GetRecEntry;
  187.       PROCEDURE Ndx_GetRecPage(Ascnd : boolean);
  188.       FUNCTION  Ndx_LastEntry : boolean;
  189.       PROCEDURE Ndx_Make(filname, formla : string; lth : integer; typ : char);
  190.       PROCEDURE Ndx_NodeData(pn, en, lo : longint; np : boolean);
  191.       PROCEDURE Ndx_Put(blk : longint);
  192.       Procedure KeyList(st : string);
  193.  
  194.  
  195.  
  196.    end;
  197. {.pa}
  198. {
  199.                          ┌──────────────────────────┐
  200.                          │  IMPLEMENTATION SECTION  │
  201.                          └──────────────────────────┘
  202. }
  203.  
  204. implementation
  205.  
  206.  
  207. const
  208.  
  209.    Next_Record = -1;   {Token value passed to read next record}
  210.    Prev_Record = -2;   {Token value passed to read previous record}
  211.    Top_Record  = -3;   {Token value passed to read first record}
  212.    Bttm_Record = -4;   {Token value passed to read final record}
  213.  
  214.    ValueHigh   = 1;    {Token value passed for key comparison high}
  215.    ValueLow    = -1;   {Token value passed for key comparison low}
  216.    ValueEqual  = 0;    {Token value passed for key comparison equal}
  217.  
  218. var
  219.    Work_Key : string;               {Holds key passed in Find and KeyUpdate}
  220.    Work_Lth : integer;              {Holds Length of Work_Key              }
  221.    Work_Num : Double;               {Holds numeric value of Work_Key if needed}
  222.    RPag     : Longint;              {Work variable to hold current index block}
  223.    RNum     : Longint;              {Work variable for record number}
  224.    IsAscend : Boolean;              {Flag for ascending/descending status.}
  225.                                     {Set based on Next/Previous Record read}
  226.  
  227.  
  228. {.pa}
  229. {
  230.                                  Ndx_Make
  231.  
  232.      ╔══════════════════════════════════════════════════════════════════╗
  233.      ║                                                                  ║
  234.      ║   The Ndx_Make method will create an index file                  ║
  235.      ║                                                                  ║
  236.      ║       Calling the Method:                                        ║
  237.      ║                                                                  ║
  238.      ║           objectname.Ndx_Make(filname, formla, lth, typ)         ║
  239.      ║                                                                  ║
  240.      ║               ( where objectname is of type GS_dBase_IX          ║
  241.      ║                        filename is of type string                ║
  242.      ║                        formla is of type string)                 ║
  243.      ║                        lth is of type integer for key length     ║
  244.      ║                        typ is of type char for field type        ║
  245.      ║                                                                  ║
  246.      ║       Result:                                                    ║
  247.      ║                                                                  ║
  248.      ║           The index file is created.                             ║
  249.      ║                                                                  ║
  250.      ╚══════════════════════════════════════════════════════════════════╝
  251. }
  252.  
  253.  
  254. Procedure GS_dBase_IX.Ndx_Make(filname, formla : string; lth : integer;
  255.                                typ : char);
  256. begin
  257.    Ndx_Name := filname+'.NDX';        {Setup file name}
  258.    GS_FileAssign(Ndx_File,Ndx_Name,NdxBufSize);
  259.    GS_FileRewrite(Ndx_File,1);
  260.    FillChar(Ndx_Hdr, SizeOf(Ndx_Hdr),#0);
  261.    Ndx_Hdr.Root := 1;
  262.    Ndx_Hdr.Next_Blk := 2;
  263.    case typ of
  264.       'N',
  265.       'D'  : begin
  266.                 Ndx_Hdr.Data_Typ := 1;
  267.                 lth := 8;
  268.              end;
  269.       else Ndx_Hdr.Data_Typ := 0;
  270.    end;
  271.    Ndx_Hdr.Key_Lgth := lth;
  272.    Ndx_Hdr.Max_Keys := (SizeOf(Ndx_Hdr)-4) div (lth+8);
  273.    Ndx_Hdr.Entry_Sz := lth+8;
  274.    CnvStrToAsc(formla,Ndx_Hdr.Key_Form, length(formla)+1);
  275.    move(Ndx_Hdr, Ndx_Data, SizeOf(Ndx_Hdr));
  276.    Ndx_Put(0);
  277.    FillChar(Ndx_Data, SizeOf(Ndx_Data),#0);
  278.    Ndx_Put(1);
  279. end;
  280. {.pa}
  281. {
  282.  
  283.                                     INIT
  284.  
  285.      ╔══════════════════════════════════════════════════════════════════╗
  286.      ║                                                                  ║
  287.      ║   The INIT method initializes objectname by reading the .NDX     ║
  288.      ║   file and loading file structure information into the object.   ║
  289.      ║                                                                  ║
  290.      ║       Calling the Method:                                        ║
  291.      ║                                                                  ║
  292.      ║           oldindex := objectname.Init(String)                    ║
  293.      ║                                                                  ║
  294.      ║               ( where oldindex is of type boolean,               ║
  295.      ║                       objectname is of type GS_dBase_IX,         ║
  296.      ║                       String is the file name of the dBase       ║
  297.      ║                       file (without the .NDX extension).         ║
  298.      ║                                                                  ║
  299.      ║       Result:                                                    ║
  300.      ║                                                                  ║
  301.      ║           Index file object is initialized.                      ║
  302.      ║           True will be returned if file exists.                  ║
  303.      ║                                                                  ║
  304.      ╚══════════════════════════════════════════════════════════════════╝
  305.  
  306.  
  307.                  ┌──────────────────────────────────────────┐
  308.                  │  The INIT method will do the following:  │
  309.                  │     1.  Open the index file              │
  310.                  │     2.  Read the first block (header)    │
  311.                  │         into objectname.                 │
  312.                  │     3.  Set Ndx_Lvl to zero, which will  │
  313.                  │         indicate no reads performed.     │
  314.                  │     4.  Return flag (false if new file)  │
  315.                  └──────────────────────────────────────────┘
  316. }
  317.  
  318. function GS_dBase_IX.Init(IName : String) : boolean;
  319. var
  320.    i : integer;
  321. begin
  322.    Ndx_Name := IName + '.NDX';
  323.    if GS_FileExists(Ndx_File, Ndx_Name) then
  324.    begin
  325.       GS_FileAssign(Ndx_File,Ndx_Name,NdxBufSize);
  326.       GS_FileReset(Ndx_File,1);
  327.       Init := true;
  328.    end
  329.    else
  330.    begin
  331.       ShowError(2,Ndx_Name);
  332.       Init := false;                  {return a flag showing no file}
  333.    end;
  334.    Ndx_Get(0);                        {Read first block of file for header info}
  335.                                       {Note that no error checking is done }
  336.                                       {in this version }
  337.    move(Ndx_Data, Ndx_Hdr, 512);      {Store in header info area}
  338.    Ndx_Lvl := 0;                      {Initialize the node step table}
  339.    Ndx_Tabl[0].Page_No := 0;
  340.    Ndx_Tabl[0].Etry_No := 0;
  341.    Ndx_Tabl[0].Last_One := 0;
  342.    KeyEOF := false;                   {Initialize EOF Flag to false}
  343.    ExactMatch := true;                {Initialize to use an exact match test}
  344. {
  345.                  ┌──────────────────────────────────────────┐
  346.                  │  This portion of code will extract the   │
  347.                  │  "formula", which is usually the field   │
  348.                  │  that is used for indexing.  However, it │
  349.                  │  can be compound (FLDA+FLDB).  The       │
  350.                  │  formula is placed in a string for use   │
  351.                  │  during index updates.                   │
  352.                  └──────────────────────────────────────────┘
  353. }
  354.    move(Ndx_Hdr.Key_Form[0], Ndx_Key_Form[1],100);
  355.    i := 1;
  356.    while Ndx_Key_Form[i] <> #0 do inc(i);
  357.    Ndx_Key_Form[0] := chr(pred(i));
  358.    Ndx_Key_Form := TrimR(Ndx_Key_Form);
  359.    Ndx_Key_Form := TrimL(Ndx_Key_Form);
  360. end;
  361. {.pa}
  362. {
  363.                                    KEYFIND
  364.  
  365.  
  366.      ╔══════════════════════════════════════════════════════════════════╗
  367.      ║                                                                  ║
  368.      ║   The KeyFind method will return the physical record location    ║
  369.      ║   of the record matching the key value passed as the argument.   ║
  370.      ║   ExactMatch controls the length of the match check.  If         ║
  371.      ║   ExactMatch is true, the entire key in the .NDX entry must      ║
  372.      ║   match the value passed.  If false, the check will only be      ║
  373.      ║   for the length of the string passed.                           ║
  374.      ║                                                                  ║
  375.      ║       Calling the Method:                                        ║
  376.      ║                                                                  ║
  377.      ║           longintvalu := objectname.KeyFind(string)              ║
  378.      ║                                                                  ║
  379.      ║               ( where objectname is of type GS_dBase_IX,         ║
  380.      ║                       string is a value used to search the       ║
  381.      ║                       .NDX file looking for a match.             ║
  382.      ║                                                                  ║
  383.      ║       Result:                                                    ║
  384.      ║                                                                  ║
  385.      ║       1.  longintvalu will point to the physical record,         ║
  386.      ║           or will be zero if no match.                           ║
  387.      ║       2.  Ndx_Key_St will contain the key value.                 ║
  388.      ║       3.  Ndx_Key_Num will contain the record number.            ║
  389.      ║                                                                  ║
  390.      ╚══════════════════════════════════════════════════════════════════╝
  391. }
  392.  
  393.  
  394. function GS_dBase_IX.KeyFind(st : string) : LongInt;
  395. var
  396.    i         : integer;               {Work variable}
  397.    rl        : integer;               {Result code for Val procedure}
  398.    ct        : integer;               {Variable to hold BlockRead byte count}
  399.    Less_Than : boolean;               {Flag to hunt for key match}
  400.    Loop_Cnt  : longint;
  401.    Match_Cnd : integer;
  402.  
  403. {
  404.                     ┌─────────────────────────────────────┐
  405.                     │  This routine sets up the match     │
  406.                     │  string.  It sets the length of the │
  407.                     │  match for full or partial, and     │
  408.                     │  converts to numeric if needed.     │
  409.                     └─────────────────────────────────────┘
  410. }
  411.    procedure SetMatchValue;
  412.    begin
  413.       FillChar(Work_Key[1], SizeOf(Work_Key), ' '); {Fill with blanks}
  414.       Work_Key := st;
  415.       if ExactMatch then
  416.          Work_Key[0] := chr(Ndx_Hdr.Key_Lgth);
  417.       Work_Lth := length(Work_Key);
  418.       if Ndx_Hdr.Data_Typ <> 0 then
  419.       begin
  420.          val(st,Work_Num,rl);
  421.          if rl <> 0 then ShowError(501,st);
  422.          move(Work_Num, Work_Key[1], 8);
  423.          Work_Lth := 8;
  424.          Work_Key[0] := chr(Work_Lth);
  425.       end;
  426.    end;
  427.  
  428.    procedure StoreMatchValue;
  429.    begin
  430.       move(Ndx_Pntr^.Char_Fld,Ndx_Key_St[1],Work_Lth);
  431.                                       {Move the key field to Ndx_Key_St.}
  432.       Ndx_Key_St[0] := chr(Work_Lth); {Now insert the length into Ndx_Key_St}
  433.    end;
  434.  
  435.    function DoMatchValue : integer;
  436.    var
  437.       nks : double;
  438.    begin
  439.       if Ndx_Hdr.Data_Typ = 0 then    {Character key field}
  440.          if Ndx_Key_St > Work_Key then Match_Cnd := ValueHigh
  441.             else if Ndx_Key_St = Work_Key then Match_Cnd := ValueEqual
  442.                else Match_Cnd := ValueLow
  443.       else                            {Numeric key field}
  444.       begin
  445.          move(Ndx_Key_St[1],nks,8);
  446.          if nks > Work_Num then Match_Cnd := ValueHigh
  447.             else if nks = Work_Num then Match_Cnd := ValueEqual
  448.                else Match_Cnd := ValueLow;
  449.       end;
  450.       DoMatchValue := Match_Cnd;
  451.    end;
  452.  
  453. begin
  454.    KeyEOF := false;                   {Reset End-of-File to false}
  455.    Ndx_Key_Num := 0;                  {Initialize}
  456.    Ndx_Key_St := '';                  {Initialize}
  457.    Ndx_Lvl := 0;                      {Initialize index level}
  458.    SetMatchValue;                     {Set key comparison value}
  459.    RPag := Ndx_Hdr.Root;              {Get root node address}
  460.    while RPag <> 0 do                 {While a non-leaf node, do this}
  461.    begin
  462.       Ndx_Get(RPag);                  {Get Node using RPag as block number}
  463.       Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary[0]);
  464.                                       {Get pointer to first entry}
  465.       Loop_Cnt := Ndx_Pntr^.Block_Ax; {Get the next node pointer to see if it}
  466.                                       {is zero, meaning a leaf node}
  467.       i := 0;                         {Initialize i as counter}
  468.       Less_Than := Ndx_Data.Entry_Ct > 0;
  469.                                       {Start out with less than flag true}
  470.                                       {Will be false if Entry Count is 0}
  471.                                       {which means an empty node}
  472.       while (less_than) and (i <= Ndx_Data.Entry_Ct) do
  473.                                       {Hunt for a match.  If i = last entry in}
  474.                                       {the node, the last entry is used for}
  475.                                       {the next node search}
  476.       begin
  477.          Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary[i *  Ndx_Hdr.Entry_Sz]);
  478.                                       {Get pointer to entry indexed by i}
  479.  
  480.          inc(i);                      {Increment the counter}
  481.          StoreMatchValue;             {Put the key value in Ndx_Key_St for}
  482.                                       {matching}
  483.  
  484.          Less_Than := DoMatchValue = ValueLow;
  485.                                       {Test looking for greater or equal than}
  486.                                       {the key value.  Less_Than will be set}
  487.                                       {false when found, setting the condition}
  488.                                       {to leave this portion of the routine}
  489.       end;
  490. {
  491.                  ┌──────────────────────────────────────────┐
  492.                  │  Save the node data for this node as:    │
  493.                  │  1.  Block Number from RPag.             │
  494.                  │  2.  Entry number of match or last one.  │
  495.                  │  3.  Set total number of entries.  This  │
  496.                  │      is entry count+1 for non-leaf nodes │
  497.                  │  4.  Set non-leaf flag to true.          │
  498.                  └──────────────────────────────────────────┘
  499. }
  500.       Ndx_NodeData(RPag,i,Ndx_Data.Entry_Ct+1,true);
  501.       if Loop_Cnt = 0 then RPag := 0
  502.          else RPag := Ndx_Pntr^.Block_Ax;
  503.                                       {Get the next node in the tree}
  504.    end;
  505.    Ndx_Tabl[Ndx_Lvl].Node_Pag := false;
  506.                                       {Set non-leaf flag to false for this}
  507.                                       {last level}
  508.    dec(Ndx_Tabl[Ndx_Lvl].Last_One);
  509.                                       {Set total number of entries to the }
  510.                                       {correct value for a leaf node}
  511.  
  512.  
  513.    if Ndx_Data.Entry_Ct = 0 then
  514.    begin
  515.       KeyFind := 0;
  516.       exit;
  517.    end;
  518.  
  519.    if (DoMatchValue <> ValueEqual) or
  520.       (Ndx_Tabl[Ndx_Lvl].Last_One < Ndx_Tabl[Ndx_Lvl].Etry_No)
  521.             then Ndx_Key_Num := 0     {if unable to find a match, the above}
  522.                                       {routine would have stopped when a}
  523.                                       {greater key was found, or would have}
  524.                                       {continued to Last_One.  Since the entry}
  525.                                       {count is one less for leaf nodes, even}
  526.                                       {if there was a match at Last_one, it is}
  527.                                       {not valid, and was only a coincidence.}
  528.                                       {In either case, set record number = 0.}
  529.    else
  530.       Ndx_Key_Num := Ndx_Pntr^.Recrd_Ax;
  531.                                       {When there is a match with the key,}
  532.                                       {get the physical record number}
  533.    KeyFind := Ndx_Key_Num;            {Return with the record number}
  534. end;
  535. {.pa}
  536. {
  537.                                   KEYLOCREC
  538.  
  539.  
  540.      ╔══════════════════════════════════════════════════════════════════╗
  541.      ║                                                                  ║
  542.      ║   The KeyLocRec method will search the .NDX file to find the     ║
  543.      ║   matching index entry pointing to the physical record location  ║
  544.      ║   of the record requested.                                       ║
  545.      ║                                                                  ║
  546.      ║       Calling the Method:                                        ║
  547.      ║                                                                  ║
  548.      ║           flag := objectname.KeyLocRec(key, position)            ║
  549.      ║                                                                  ║
  550.      ║               ( where objectname is of type GS_dBase_IX,         ║
  551.      ║                       key is the key string                      ║
  552.      ║                       position is the physical record number     ║
  553.      ║                          of the matching .DBF record.)           ║
  554.      ║                                                                  ║
  555.      ║       Result:                                                    ║
  556.      ║                                                                  ║
  557.      ║           Boolean True is returned if a match is found.          ║
  558.      ║           The current index entry will be set to the record      ║
  559.      ║           if a match does exist.                                 ║
  560.      ║                                                                  ║
  561.      ╚══════════════════════════════════════════════════════════════════╝
  562. }
  563.  
  564.  
  565. Function GS_dBase_IX.KeyLocRec (rec : longint) : boolean;
  566. var
  567.    lr : longint;
  568. begin
  569.    if rec = Ndx_Key_Num then
  570.    begin                              {Exit if already at the record}
  571.       KeyLocRec := true;
  572.       exit;
  573.    end;
  574.    lr := KeyRead(Top_Record);
  575.    while (not KeyEOF) and (lr <> rec) do lr := KeyRead(Next_Record);
  576.    if (KeyEOF) then KeyLocRec := false
  577.       else KeyLocRec := true;
  578. end;
  579. {.pa}
  580. {
  581.                                    KEYREAD
  582.  
  583.  
  584.      ╔══════════════════════════════════════════════════════════════════╗
  585.      ║                                                                  ║
  586.      ║   The KeyRead method will return the physical record location    ║
  587.      ║   of the record requested.  The only options that may be asked   ║
  588.      ║   for are Top, Bottom, Next, and Previous.                       ║
  589.      ║                                                                  ║
  590.      ║       Calling the Method:                                        ║
  591.      ║                                                                  ║
  592.      ║           longintvalu := objectname.KeyRead(position)            ║
  593.      ║                                                                  ║
  594.      ║               ( where objectname is of type GS_dBase_IX,         ║
  595.      ║                       position is in -1 to -4,                   ║
  596.      ║                       longintvalu is physical record number      ║
  597.      ║                          of the matching .DBF record.            ║
  598.      ║                                                                  ║
  599.      ║       Result:                                                    ║
  600.      ║                                                                  ║
  601.      ║           longintvalu will point to the physical record.         ║
  602.      ║                                                                  ║
  603.      ╚══════════════════════════════════════════════════════════════════╝
  604. }
  605.  
  606.  
  607. FUNCTION  GS_dBase_IX.KeyRead(a : longint) : longint;
  608. var
  609.    N_L_Hold   : Integer;              {Tempory variable for index level}
  610.    ct         : Integer;              {Work variable for Blockread count}
  611.  
  612.  
  613.  
  614. {
  615.                ┌───────────────────────────────────────────────┐
  616.                │  Start of KeyRead function.  This will        │
  617.                │  accomplish the following:                    │
  618.                │                                               │
  619.                │  1.  If first time for index, set any call    │
  620.                │      for a Next or Previous read to a Top     │
  621.                │      read command.                            │
  622.                │  2.  Use case select for Top/Bttm/Next/Prev.  │
  623.                │      Return physical .DBF record in RNum.     │
  624.                │  3.  If not a valid action, set RNum to 0.    │
  625.                │  4.  Move key value to Ndx_Key_St.            │
  626.                │  5.  Move RNum to Ndx_Key_Num.                │
  627.                │  6.  Return RNum value to calling procedure.  │
  628.                └───────────────────────────────────────────────┘
  629. }
  630.  
  631.  
  632. { Start of KeyRead }
  633.  
  634. begin
  635.    RNum := a;                         {Get action command}
  636.    if ((a = Next_Record) or (a = Prev_Record)) and
  637.       (Ndx_Lvl = 0) then RNum := Top_Record;
  638.                                       {if first time through, use Top_Record}
  639.                                       {command instead}
  640.    KeyEOF := false;                   {End-of-File initially set false}
  641.    case RNum of                       {Select KeyRead Action}
  642.  
  643.       Next_Record : begin
  644.                        IsAscend := true;
  645.                                       {Will be an ascending read}
  646.                        N_L_Hold := Ndx_Lvl;
  647.                                       {Save old index level}
  648. {
  649.                     ┌─────────────────────────────────────┐
  650.                     │  If the last record read was the    │
  651.                     │  last entry in the node, you have   │
  652.                     │  to step back through the index     │
  653.                     │  levels to find the next node.      │
  654.                     └─────────────────────────────────────┘
  655. }
  656.                        if Ndx_LastEntry then
  657.                                       {If last entry in node already used,}
  658.                                       {go find the next node}
  659.                        begin
  660.                           while (Ndx_LastEntry) and (Ndx_Lvl > 0) do
  661.                              dec(Ndx_Lvl);
  662.                                       {Step back through the levels until you}
  663.                                       {find a good one, or run out of levels.}
  664.  
  665.                           if Ndx_Lvl = 0 then
  666.                                       {if out of levels, process for EOF}
  667.                           begin
  668.                              Ndx_Lvl := N_L_Hold;
  669.                                       {Get old level number to restore}
  670.                              KeyEOF := true;
  671.                                       {Set End-of-File true}
  672.                           end else
  673.  
  674.                           begin       {Otherwise, get next entry data}
  675.                              inc(Ndx_Tabl[Ndx_Lvl].Etry_No);
  676.                                       {Step to next Entry Number}
  677.                              Ndx_GetRecEntry;
  678.                                       {Go search for next good record}
  679.                           end;
  680.                        end
  681.  
  682.                        else inc(Ndx_Tabl[Ndx_Lvl].Etry_No);
  683.                                       {Otherwise, just step to next entry}
  684.                        Ndx_Pntr :=
  685.                                     Addr(Ndx_Data.Data_Ary[(
  686.                                     (Ndx_Tabl[Ndx_Lvl].Etry_No - 1) *
  687.                                     Ndx_Hdr.Entry_Sz)]);
  688.                                       {Get pointer to the key entry}
  689.                        RNum := Ndx_Pntr^.Recrd_Ax;
  690.                                       {Get record number for the key entry}
  691.                     end;
  692.  
  693.       Prev_Record : begin
  694.                        IsAscend := false;
  695.                                       {Will be a descending read}
  696.                        N_L_Hold := Ndx_Lvl;
  697.                                       {Save old index level}
  698. {
  699.                     ┌─────────────────────────────────────┐
  700.                     │  If the last record read was the    │
  701.                     │  first entry in the node, you have  │
  702.                     │  to step back through the index     │
  703.                     │  levels to find the next node.      │
  704.                     └─────────────────────────────────────┘
  705. }
  706.                        if Ndx_Tabl[Ndx_Lvl].Etry_No = 1 then
  707.                                       {If last entry in node already used,}
  708.                                       {go find the next node}
  709.                        begin
  710.                           while (Ndx_Tabl[Ndx_Lvl].Etry_No = 1) and
  711.                                 (Ndx_Lvl > 0) do
  712.                              dec(Ndx_Lvl);
  713.                                       {Step back through the levels until you}
  714.                                       {find a good one, or run out of levels.}
  715.  
  716.                           if Ndx_Lvl = 0 then
  717.                                       {if out of levels, process for EOF}
  718.                           begin
  719.                              Ndx_Lvl := N_L_Hold;
  720.                                       {Get old level number to restore}
  721.                              KeyEOF := true;
  722.                                       {Set End-of-File true}
  723.                           end else
  724.  
  725.                           begin       {Otherwise, get next entry data}
  726.                              dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  727.                                       {Step to next Entry Number}
  728.                              Ndx_GetRecEntry;
  729.                                       {Go search for next good record}
  730.                           end;
  731.                        end
  732.                        else dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  733.                                       {Otherwise, just step to next entry}
  734.                        Ndx_Pntr :=
  735.                                     Addr(Ndx_Data.Data_Ary[(
  736.                                     (Ndx_Tabl[Ndx_Lvl].Etry_No - 1) *
  737.                                     Ndx_Hdr.Entry_Sz)]);
  738.                                       {Get pointer to the key entry}
  739.                        RNum := Ndx_Pntr^.Recrd_Ax;
  740.                                       {Get record number for the key entry}
  741.                     end;
  742.  
  743.       Top_Record,
  744.       Bttm_Record : begin
  745.                        IsAscend := Top_Record = RNum;
  746.                                       {Ascending search if Top, otherwise}
  747.                                       {descending.  An ascending search will}
  748.                                       {return the first index key as the Top.}
  749.                                       {A descending search will return the}
  750.                                       {last index key as the 'Top'}
  751.                        Ndx_Lvl := 0;  {Clear index levels for new stack}
  752.                        RPag := Ndx_Hdr.Root;
  753.                                       {Get root node address}
  754.                        Ndx_GetRecPage(IsAscend);
  755.                                       {Go get valid record}
  756.                     end;
  757.  
  758.       else          RNum := 0;        {If no valid action, return zero}
  759.    end;
  760.    move(Ndx_Pntr^.Char_Fld,Ndx_Key_St[1],Ndx_Hdr.Key_Lgth);
  761.                                       {Move the key field to Ndx_Key_St.}
  762.                                       {The Move procedure must be used since}
  763.                                       {Char_Fld is not a true Pascal string.}
  764.    Ndx_Key_St[0] := chr(Ndx_Hdr.Key_Lgth);
  765.                                       {Now insert the length into Ndx_Key_St}
  766.                                       {so it is a valid string we can use}
  767.  
  768.    Ndx_Key_Num := RNum;               {Save RNum in Ndx_Key_Num}
  769.    KeyRead := RNum;                   {Return RNum}
  770. end;
  771. {.pa}
  772. {
  773.                                  NDX_CLOSE
  774.  
  775.  
  776.      ╔══════════════════════════════════════════════════════════════════╗
  777.      ║                                                                  ║
  778.      ║   The Ndx_Close method will close the index file from this       ║
  779.      ║   object.                                                        ║
  780.      ║                                                                  ║
  781.      ║       Calling the Method:                                        ║
  782.      ║                                                                  ║
  783.      ║           objectname.Ndx_Close                                   ║
  784.      ║                                                                  ║
  785.      ║               ( where objectname is of type GS_dBase_IX          ║
  786.      ║                                                                  ║
  787.      ║       Result:                                                    ║
  788.      ║                                                                  ║
  789.      ║           The index file is closed.                              ║
  790.      ║                                                                  ║
  791.      ╚══════════════════════════════════════════════════════════════════╝
  792. }
  793.  
  794.  
  795. Procedure GS_dBase_IX.Ndx_Close;
  796. begin
  797.    GS_FileClose(Ndx_File);
  798. end;
  799.  
  800. {.pa}
  801. {
  802.                                   NDX_GET
  803.  
  804.  
  805.      ╔══════════════════════════════════════════════════════════════════╗
  806.      ║                                                                  ║
  807.      ║   The Ndx_Get method will read a block from the index file for   ║
  808.      ║   this object.                                                   ║
  809.      ║                                                                  ║
  810.      ║       Calling the Method:                                        ║
  811.      ║                                                                  ║
  812.      ║           objectname.Ndx_Get(Blk)                                ║
  813.      ║                                                                  ║
  814.      ║               ( where objectname is of type GS_dBase_IX          ║
  815.      ║                       blk is longint number of block to read)    ║
  816.      ║                                                                  ║
  817.      ║       Result:                                                    ║
  818.      ║                                                                  ║
  819.      ║           The index block (node) is read into Ndx_Data           ║
  820.      ║                                                                  ║
  821.      ╚══════════════════════════════════════════════════════════════════╝
  822. }
  823.  
  824.  
  825. Procedure GS_dBase_IX.Ndx_Get(blk : longint);
  826. var
  827.    r : word;
  828. begin
  829.    GS_FileRead(Ndx_File,blk*512,Ndx_Data,512,r);
  830.    if r < 512 then ShowError(100,'Ndx_Get');
  831. end;
  832.  
  833. Procedure GS_dBase_IX.Ndx_NodeData(pn, en, lo : longint; np : boolean);
  834. begin
  835.    inc(Ndx_Lvl);                      {Prepare to store node information as}
  836.                                       {part of the Ndx_Lvl hierarchy}
  837.    with Ndx_Tabl[Ndx_Lvl] do          {Use the index level entry}
  838.    begin
  839.       Page_No := pn;                  {Save Block number}
  840.       Etry_No := en;                  {Set entry number}
  841.       Last_One := lo;                 {Set total number of entries.}
  842.       Node_Pag := np;                 {Set non-leaf flag}
  843.    end;
  844. end;
  845.  
  846. {
  847.                     ┌─────────────────────────────────────┐
  848.                     │  This procedure will locate the     │
  849.                     │  starting page to search for an     │
  850.                     │  entry.  It selects the entry       │
  851.                     │  number contained at the present    │
  852.                     │  index level and passes its node    │
  853.                     │  pointer to Get_PageRec.  This is   │
  854.                     │  needed to read the index blocks in │
  855.                     │  the correct sequence.              │
  856.                     └─────────────────────────────────────┘
  857. }
  858.  
  859. procedure GS_dBase_IX.Ndx_GetRecEntry;
  860. begin
  861.    RPag := Ndx_Tabl[Ndx_Lvl].Page_No;
  862.                                       {Get page number for this index level}
  863.    Ndx_Get(RPag);                     {Get Node using RPag as block number}
  864.    Ndx_Pntr := Addr(Ndx_Data.Data_Ary[(Ndx_Tabl[Ndx_Lvl].Etry_No- 1)
  865.                                           * Ndx_Hdr.Entry_Sz]);
  866.                                       {Get pointer to key entry (relative zero)}
  867.    RPag := Ndx_Pntr^.Block_Ax;        {Get Next node number in RPag}
  868.    Ndx_GetRecPage(IsAscend);          {Go get the next record from a non-leaf}
  869.                                       {node.  Pass the argument for either an}
  870.                                       {ascending or descending search}
  871. end;
  872. {
  873.                     ┌─────────────────────────────────────┐
  874.                     │  This procedure will step the nodes │
  875.                     │  until it finds a leaf node.  The   │
  876.                     │  starting node is contained in the  │
  877.                     │  variable RPag; the record number   │
  878.                     │  of the first or last key (based)   │
  879.                     │  on Ascnd) will be placed in RNum.  │
  880.                     └─────────────────────────────────────┘
  881. }
  882. procedure GS_dBase_IX.Ndx_GetRecPage(Ascnd : boolean);
  883. var
  884.    ec : integer;                      {Work variable for entry count}
  885. begin
  886.     while RPag <> 0 do                {Next node number in RPag will be zero}
  887.                                       {when taken from a leaf node.}
  888.     begin
  889.        Ndx_Get(RPag);                 {Get Node using RPag as block number}
  890.        Ndx_NodeData(RPag,0,Ndx_Data.Entry_Ct+1,true);
  891.                                       {Store Node data}
  892. {
  893.                ┌───────────────────────────────────────────────┐
  894.                │  This portion of code checks to see if called │
  895.                │  by Next/Top or Bttm/Prev, and sets the entry │
  896.                │  to 1 or last node entry, based on Ascnd      │
  897.                └───────────────────────────────────────────────┘
  898. }
  899.        if Ascnd then
  900.        begin
  901.           ec := 0;                    {Set ec = first entry (relative zero)}
  902.           Ndx_Tabl[Ndx_Lvl].Etry_No := 1;
  903.                                       {Set Entry Number in table to first one}
  904.        end else
  905.        begin
  906.           ec := Ndx_Data.Entry_Ct;    {Set ec to last entry (relative zero)}
  907.                                       {Note there are Entry_Ct+1 entries for}
  908.                                       {non-leaf nodes.  It will be adjusted}
  909.                                       {later if it is a leaf node}
  910.           Ndx_Tabl[Ndx_Lvl].Etry_No := ec+1;
  911.                                       {Set Entry Number in table to last one}
  912.        end;
  913.  
  914.        Ndx_Pntr := Addr(Ndx_Data.Data_Ary[ec * Ndx_Hdr.Entry_Sz]);
  915.                                       {Get pointer to correct entry in node}
  916.        RPag := Ndx_Pntr^.Block_Ax;    {Get Next node number in RPag}
  917.     end;
  918. {
  919.                ┌───────────────────────────────────────────────┐
  920.                │  This portion of code checks to see if the    │
  921.                │  index file is empty.  If so, the EOF is set  │
  922.                │  and the routine is quit.                     │
  923.                └───────────────────────────────────────────────┘
  924. }
  925.     if Ndx_Data.Entry_Ct = 0 then
  926.     begin
  927.        KeyEOF := true;
  928.        RNum := 0;
  929.        exit;
  930.     end;
  931.     Ndx_Tabl[Ndx_Lvl].Node_Pag := false;
  932.                                       {Set non-leaf flag to false for leaf}
  933.     if not Ascnd then
  934.     begin
  935.        dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  936.                                       {Set Entry Number in table to last one}
  937.                                       {for a non-leaf node}
  938.        Ndx_Pntr := Addr(Ndx_Data.Data_Ary[ec-1 * Ndx_Hdr.Entry_Sz]);
  939.                                       {Get pointer to correct leaf entry for}
  940.                                       {the last entry in the node}
  941.     end;
  942.     Ndx_Tabl[Ndx_Lvl].Node_Pag := false;
  943.                                       {Set non-leaf flag to false for this}
  944.                                       {last level}
  945.     dec(Ndx_Tabl[Ndx_Lvl].Last_One);  {Set total number of entries to the }
  946.                                       {correct value for a leaf node}
  947.     RNum := Ndx_Pntr^.Recrd_Ax;       {Get the physical record number for}
  948.                                       {the first key entry}
  949. end;
  950.  
  951. {
  952.                ┌───────────────────────────────────────────────┐
  953.                │  This function will return true if all        │
  954.                │  entries have been processed in the           │
  955.                │  Ndx_Lvl layer number passed to the function  │
  956.                └───────────────────────────────────────────────┘
  957. }
  958.  
  959. function GS_dBase_IX.Ndx_LastEntry : boolean;
  960. begin
  961.    if Ndx_Tabl[Ndx_Lvl].Etry_No = Ndx_Tabl[Ndx_Lvl].Last_One then
  962.        Ndx_LastEntry := true else Ndx_LastEntry := false;
  963. end;
  964. {.pa}
  965. {
  966.                                   NDX_PUT
  967.  
  968.  
  969.      ╔══════════════════════════════════════════════════════════════════╗
  970.      ║                                                                  ║
  971.      ║   The Ndx_Put method will write a block from the index file for  ║
  972.      ║   this object.                                                   ║
  973.      ║                                                                  ║
  974.      ║       Calling the Method:                                        ║
  975.      ║                                                                  ║
  976.      ║           objectname.Ndx_Put(Blk)                                ║
  977.      ║                                                                  ║
  978.      ║               ( where objectname is of type GS_dBase_IX          ║
  979.      ║                       blk is longint number of block to write)   ║
  980.      ║                                                                  ║
  981.      ║       Result:                                                    ║
  982.      ║                                                                  ║
  983.      ║           The index block (node) is written from Ndx_Data        ║
  984.      ║                                                                  ║
  985.      ╚══════════════════════════════════════════════════════════════════╝
  986. }
  987.  
  988.  
  989. Procedure GS_dBase_IX.Ndx_Put(blk : longint);
  990. var
  991.    r : word;
  992. begin
  993.    GS_FileWrite(Ndx_File,blk*512,Ndx_Data,512,r);
  994.    if r < 512 then ShowError(101,'Ndx_Put');
  995. end;
  996.  
  997.  
  998. Procedure GS_dBase_IX.KeyUpdate (st : string; rec, crec : longint);
  999. var
  1000.    ct : integer;
  1001.    nu_key : longint;
  1002.    em_hold : boolean;                 {holds ExactMatch flag during this}
  1003.    t_num  : double;
  1004.    lr,
  1005.    b1,
  1006.    b2  : longint;
  1007.    rlst,
  1008.    e1,
  1009.    e2,
  1010.    n1,
  1011.    n2  : integer;
  1012.    s1,
  1013.    s2  : string[127];
  1014.    r1  : GS_Indx_Data;
  1015.  
  1016.  
  1017.  
  1018.    Procedure FixKeyLength;
  1019.    begin
  1020.       FillChar(Work_Key[1], 255, ' '); {Fill with blanks}
  1021.       Work_Key := st;
  1022.       if Ndx_Hdr.Data_Typ = 0 then
  1023.       begin
  1024.          Work_Key[0] := chr(Ndx_Hdr.Key_Lgth);
  1025.          Work_Lth := Ndx_Hdr.Key_Lgth;
  1026.       end
  1027.       else
  1028.       begin
  1029.          val(st,Work_Num,rlst);
  1030.          if rlst <> 0 then ShowError(501,st);
  1031.          move(Work_Num, Work_Key[1], 8);
  1032.          Work_Lth := 8;
  1033.          Work_Key[0] := #8;
  1034.       end;
  1035.    end;
  1036.  
  1037.    Procedure DeleteEntry;
  1038.    begin
  1039.       with Ndx_Tabl[Ndx_Lvl] do
  1040.       begin
  1041.          move(Ndx_Data.Data_Ary[(Etry_No)*Ndx_Hdr.Entry_Sz],
  1042.               Ndx_Data.Data_Ary[(Etry_No-1)*Ndx_Hdr.Entry_Sz],
  1043.               Ndx_Hdr.Entry_Sz*(Last_One-Etry_No));
  1044.          dec(Last_One);
  1045.          dec(Ndx_Data.Entry_Ct);
  1046.       end;
  1047.    end;
  1048.  
  1049.  
  1050.    Procedure InsertEntry;
  1051.    begin
  1052.       with Ndx_Tabl[Ndx_Lvl] do
  1053.       begin
  1054.          if (Etry_No <> 0) and (not KeyEOF) then
  1055.          begin
  1056.             move(Ndx_Data.Data_Ary[(Etry_No-1)*Ndx_Hdr.Entry_Sz],
  1057.                  Ndx_Data.Data_Ary[(Etry_No)*Ndx_Hdr.Entry_Sz],
  1058.                  Ndx_Hdr.Entry_Sz*(((Last_One-Etry_No)+1)));
  1059.             Ndx_Pntr := Addr(Ndx_Data.Data_Ary[(Etry_No-1) * Ndx_Hdr.Entry_Sz]);
  1060.          end
  1061.          else
  1062.          begin
  1063.             Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Etry_No*Ndx_Hdr.Entry_Sz]);
  1064.             inc(Etry_No);
  1065.          end;
  1066.          inc(Last_One);
  1067.          inc(Ndx_Data.Entry_Ct);
  1068.          move(Work_Key[1],Ndx_Pntr^.Char_Fld,Work_Lth)
  1069.                                       {Move the key field from Work_Key.}
  1070.                                       {The Move procedure must be used since}
  1071.                                       {Char_Fld is not a true Pascal string.}
  1072.       end;
  1073.    end;
  1074.  
  1075.    procedure ReplacePointerEntry;
  1076.    begin
  1077.       while (Ndx_LastEntry) and (Ndx_Lvl > 0) do dec(Ndx_Lvl);
  1078.                                       {Search for entry that requires the key}
  1079.                                       {value.  Value is not needed for the}
  1080.                                       {last entry in a non-leaf node.}
  1081.       if Ndx_Lvl > 0 then
  1082.       begin                           {Replace key value with new one}
  1083.          Ndx_Get(Ndx_Tabl[Ndx_Lvl].Page_No);
  1084.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary
  1085.                           [(Ndx_Tabl[Ndx_Lvl].Etry_No-1) * Ndx_Hdr.Entry_Sz]);
  1086.          move(Ndx_Key_St[1],Ndx_Pntr^.Char_Fld,Work_Lth);
  1087.                                       {Move the key field from Ndx_Key_St.}
  1088.          Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1089.                                       {Write updated node to disk}
  1090.       end;
  1091.    end;
  1092.  
  1093.  
  1094.    Procedure KeyDelete;
  1095.    begin
  1096.       DeleteEntry;
  1097.       Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1098.       if Ndx_Tabl[Ndx_Lvl].Last_One = 0 then
  1099.       begin
  1100.          dec(Ndx_Lvl);
  1101.          if Ndx_Lvl > 0 then
  1102.          begin
  1103.             Ndx_Get(Ndx_Tabl[Ndx_Lvl].Page_No);
  1104.             KeyDelete;
  1105.          end;
  1106.          exit;
  1107.       end;
  1108.       if Ndx_Tabl[Ndx_Lvl].Etry_No > Ndx_Tabl[Ndx_Lvl].Last_One then
  1109.       begin
  1110.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary
  1111.                            [(Ndx_Tabl[Ndx_Lvl].Last_One-1) * Ndx_Hdr.Entry_Sz]);
  1112.          move(Ndx_Pntr^.Char_Fld,Ndx_Key_St[1],Work_Lth);
  1113.                                       {Move the key field to Ndx_Key_St.}
  1114.                                       {The Move procedure must be used since}
  1115.                                       {Char_Fld is not a true Pascal string.}
  1116.          Ndx_Key_St[0] := chr(Work_Lth);
  1117.                                       {Now insert the length into Ndx_Key_St}
  1118.                                       {so it is a valid string we can use}
  1119.          dec(Ndx_Lvl);
  1120.          if Ndx_Lvl > 0 then ReplacePointerEntry;
  1121.       end;
  1122.    end;
  1123.  
  1124.  
  1125.    Procedure SplitBlock;
  1126.    begin
  1127.       b1 := Ndx_Hdr.Next_Blk;
  1128.       inc(Ndx_Hdr.Next_Blk);
  1129.       Ndx_NodeData(b1,1,Ndx_Tabl[Ndx_Lvl].Last_One,Ndx_Tabl[Ndx_Lvl].Node_Pag);
  1130.       with Ndx_Tabl[Ndx_Lvl] do
  1131.       begin
  1132.          n1 := Ndx_Lvl;
  1133.          Ndx_Data.Entry_Ct := Last_One div 2;
  1134.          e2 := Last_One - Ndx_Data.Entry_Ct;
  1135.          Last_One := Ndx_Data.Entry_Ct;
  1136.          e1 := Last_One;
  1137.          if Node_Pag then dec(Ndx_Data.Entry_Ct);
  1138.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary
  1139.                           [(Ndx_Tabl[Ndx_Lvl].Last_One-1) * Ndx_Hdr.Entry_Sz]);
  1140.          move(Ndx_Pntr^.Char_Fld,s1[1],Work_Lth);
  1141.          s1[0] := chr(Work_Lth);
  1142.          Ndx_Put(Page_No);
  1143.       end;
  1144.       dec(Ndx_Lvl);
  1145.       with Ndx_Tabl[Ndx_Lvl] do
  1146.       begin
  1147.          b2 := Page_No;
  1148.          n2 := Ndx_Lvl;
  1149.          Last_One := e2;
  1150.          Ndx_Data.Entry_Ct := e2;
  1151.          if Node_Pag then dec(Ndx_Data.Entry_Ct);
  1152.          move(Ndx_Data.Data_Ary[e1*Ndx_Hdr.Entry_Sz],
  1153.               Ndx_Data.Data_Ary[0],Ndx_Hdr.Entry_Sz*(e2));
  1154.          Ndx_Put(Page_No);
  1155.          move(Ndx_Hdr, Ndx_Data, 512);
  1156.                                       {Store from header info area}
  1157.          Ndx_Put(0);
  1158.          dec(Ndx_Lvl);
  1159.       end;
  1160.    end;
  1161.  
  1162.  
  1163.    Procedure MakeRootNode;
  1164.    begin
  1165.       Ndx_Lvl := 0;
  1166.       with Ndx_Tabl[Ndx_Lvl] do
  1167.       begin
  1168.          Page_No := Ndx_Hdr.Next_Blk;
  1169.          inc(Ndx_Hdr.Next_Blk);
  1170.          Ndx_Hdr.Root := Page_No;
  1171.          move(Ndx_Hdr, Ndx_Data, 512);
  1172.                                       {Store from header info area}
  1173.          Ndx_Put(0);
  1174.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary[0]);
  1175.          Ndx_Data.Entry_Ct := 0;
  1176.          Ndx_Pntr^.Recrd_Ax := 0;
  1177.          Ndx_Pntr^.Block_Ax := b2;
  1178.          Last_One := 1;
  1179.          Etry_No := 1;
  1180.          Ndx_Put(Page_No);
  1181.       end;
  1182.    end;
  1183.  
  1184.    procedure ExpandIndex;
  1185.    var
  1186.       kEOF : boolean;
  1187.    begin
  1188.       SplitBlock;
  1189.       if Ndx_Lvl = 0 then MakeRootNode;
  1190.       Work_Key := s1;
  1191.       Ndx_Get(Ndx_Tabl[Ndx_Lvl].Page_No);
  1192.       kEOF := KeyEOF;
  1193.       KeyEOF := false;
  1194.       InsertEntry;
  1195.       KeyEOF := kEOF;
  1196.       Ndx_Pntr^.Recrd_Ax := 0;
  1197.       Ndx_Pntr^.Block_Ax := b1;
  1198.       if Ndx_Tabl[Ndx_Lvl].Last_One <= Ndx_Hdr.Max_Keys then
  1199.       begin
  1200.          Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1201.       end else
  1202.       begin
  1203.          ExpandIndex;
  1204.       end;
  1205.    end;
  1206.  
  1207.    Procedure KeyInsert;
  1208.    begin
  1209.       nu_key := KeyFind(st);
  1210.       if nu_key <> 0 then
  1211.       begin
  1212.          if Ndx_Hdr.Data_Typ = 0 then
  1213.             while (Ndx_Key_St = Work_Key) and (not KeyEOF) do
  1214.                nu_key := KeyRead(Next_Record)
  1215.          else
  1216.          begin
  1217.             move(Ndx_Key_St[1],t_num,8);
  1218.             while (t_num = Work_Num) and (not KeyEOF) do
  1219.                nu_key := KeyRead(Next_Record);
  1220.          end;
  1221.       end;
  1222.       InsertEntry;
  1223.       Ndx_Pntr^.Recrd_Ax := rec;
  1224.       Ndx_Pntr^.Block_Ax := 0;
  1225.       if Ndx_Tabl[Ndx_Lvl].Etry_No > Ndx_Tabl[Ndx_Lvl].Last_One then
  1226.       begin
  1227.          r1 := Ndx_Data;
  1228.          n1 := Ndx_Lvl;
  1229.          Ndx_Key_St := Work_Key;
  1230.          ReplacePointerEntry;
  1231.          Ndx_Lvl := n1;
  1232.          Ndx_Data := r1;
  1233.       end;
  1234.       if Ndx_Tabl[Ndx_Lvl].Last_One <= Ndx_Hdr.Max_Keys then
  1235.       begin
  1236.          Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1237.       end else
  1238.       begin
  1239.          ExpandIndex;
  1240.       end;
  1241.    end;
  1242.  
  1243. begin
  1244.    FixKeyLength;
  1245.    if rec = crec then                 {Tests for Append vs Update}
  1246.    begin
  1247.       if Work_Key = Ndx_Key_St then exit;
  1248.       KeyDelete;
  1249.    end;
  1250.    em_hold := ExactMatch;
  1251.    ExactMatch := true;
  1252.    KeyInsert;
  1253.    ExactMatch := em_hold;
  1254.    if crec < 0 then exit;
  1255.    lr := KeyFind(st);
  1256.    while lr <> rec do lr := KeyRead(Next_Record);
  1257. end;
  1258.  
  1259. Procedure GS_dBase_IX.KeyList(st : string);
  1260. var
  1261.    ofil      : text;
  1262.    RPag      : LongInt;
  1263.    Lst_One,
  1264.    i,j,k,v   : integer;
  1265.    rl        : integer;
  1266.    ct        : integer;
  1267.    recnode,
  1268.    Less_Than : boolean;
  1269. begin
  1270.    assign(ofil, st);
  1271.    ReWrite(ofil);
  1272.    with Ndx_Hdr do
  1273.    begin
  1274.       writeln(ofil,'--------------------------------------------------');
  1275.       writeln(ofil,'':8,Ndx_Key_St);
  1276.       writeln(ofil,'Root =',Root:3,'   Next Block Available:',Next_Blk:3);
  1277.    end;
  1278.    RPag := 1;
  1279.    while RPag <> Ndx_Hdr.Next_Blk do
  1280.    begin
  1281.       Seek(Ndx_File,RPag*512);
  1282.       BlockRead(Ndx_File,Ndx_Data,512,ct);
  1283.       Lst_One := Ndx_Data.Entry_Ct+1;
  1284.       write(ofil,RPag:2,'  [',Ndx_Data.Entry_Ct,'] ');
  1285.       Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary[0]);
  1286.       recnode := Ndx_Pntr^.Block_Ax = 0;
  1287.       k := Lst_One;
  1288.       if recnode then dec(k);
  1289.       v := 1;
  1290.       i := 1;
  1291.       while (i <= k) do
  1292.       begin
  1293.          Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary[((i-1) *  Ndx_Hdr.Entry_Sz)]);
  1294.          with Ndx_Pntr^ do
  1295.          begin
  1296.             write(ofil,'':v,Block_Ax:3);
  1297.             v := 9;
  1298.             if i = Lst_One then write(ofil,'     - empty')
  1299.             else
  1300.                begin
  1301.                   write(ofil,Recrd_Ax:4,' ');
  1302.                   write(ofil,Numb_Fld:6:0);
  1303. {                  for j := 1 to 5 do write(ofil,Char_Fld[j]);}
  1304.                end;
  1305.          WRITELN(OFIL);
  1306.          end;
  1307.          inc(i);
  1308.       end;
  1309.       writeln(ofil);
  1310.       inc(RPag);
  1311.    end;
  1312.    System.Close(ofil);
  1313. end;
  1314.  
  1315.  
  1316.  
  1317.  
  1318. end.
  1319.  
  1320.